#lang rosetta-racket


(provide brick-width
         brick-height
         
         cylinder-height
         cylinder-radius
         
         1x1x0-shape
         1x1x1-shape
         make-xyz-shape
         
         (struct-out brick)
         make-xyz-brick
         right
         back
         1x1x0
         1x1x1)


(define brick-unit 1.6)

(define brick-width (* 5 brick-unit))
(define brick-height (* 6 brick-unit))

(define cylinder-height (* 1 brick-unit))
(define cylinder-radius (* 1.5 brick-unit))


; utils

(define (move-inc move-fn s shapes)
  (map
   call
   (map (cλ cλ move-fn) (: < 0 .. s .. < (length shapes) > >))
   shapes))

(define move-x-inc (cλ move-inc move-x))
(define move-y-inc (cλ move-inc move-y))
(define move-z-inc (cλ move-inc move-z))

(define (vector-set vec pos val)
  (let ((vec2 (vector-copy vec)))
    (vector-set! vec2 pos val)
    vec2))

(define (vector-set-vals vec poss vals)
  (let ((vec2 (vector-copy vec)))
    (for ((pos poss) (val vals))
      (vector-set! vec2 pos val))
    vec2))

(define (cross lst1 lst2)
  (append*
   (for/list ((i lst1))
     (for/list ((j lst2))
       (list i j)))))

(define (cross-area p size)
  (cross
   (: < (xyz-x p) .. < (xyz-x size) > >)
   (: < (xyz-y p) .. < (xyz-y size) > >)))


; shape

(define 1x1x0-shape
  (move-xy
   (/2 brick-width)
   (/2 brick-width)
   (union
    (cylinder cylinder-radius cylinder-height)
    (surface (rectangle brick-width brick-width)))))

(define 1x1x1-shape
  (move-xy
   (/2 brick-width)
   (/2 brick-width)
   (union
    (cylinder (z brick-height) cylinder-radius cylinder-height)
    (box-center brick-width brick-width brick-height 'bottom))))

;(define 1x1x1-shape
;  (move-xy
;   (/2 brick-width)
;   (/2 brick-width)
;   (box-center brick-width brick-width brick-height 'bottom)))

;(define (make-xyz-shape x y z)
;  (let ((x-shape
;         (if (<= x 1)
;             1x1x1-shape
;             (apply on-right (repeat x (list 1x1x1-shape))))))
;    (let ((y-shape
;           (if (<= y 1)
;               x-shape
;               (apply on-back (repeat y (list x-shape))))))
;      (if (<= z 1)
;          y-shape
;          (union (move-z-inc brick-height (repeat z (list y-shape))))))))

(define (make-xyz-shape x y z)
  (let ((x-shape
         (if (<= x 1)
             1x1x1-shape
             (union (move-x-inc brick-width (repeat x (list 1x1x1-shape)))))))
    (let ((y-shape
           (if (<= y 1)
               x-shape
               (union (move-y-inc brick-width (repeat y (list x-shape)))))))
      (if (<= z 1)
          y-shape
          (union (move-z-inc brick-height (repeat z (list y-shape))))))))


; brick

(struct brick
  (shape cs size)
  #:constructor-name make-brick)

(define (make-xyz-brick x y z)
  (make-brick (make-xyz-shape x y z) u0 (xyz x y z)))

(define (right b)
  (match b
    ((brick shape cs size)
     (make-brick shape (xy (- (- (xyz-x size) 1)) (xyz-y cs)) size))))

(define (back b)
  (match b
    ((brick shape cs size)
     (make-brick shape (xy (xyz-x cs) (- (- (xyz-y size) 1))) size))))


(define 1x1x0 (make-brick 1x1x0-shape u0 (xyz 1 1 0)))
(define 1x1x1 (make-brick 1x1x1-shape u0 (xyz 1 1 1)))